home *** CD-ROM | disk | FTP | other *** search
/ Aminet 16 / Aminet 16 (1996)(GTI - Schatztruhe)[!][Dec 1996].iso / Aminet / dev / src / wangisrc.lha / wangi / z / Bush / Bush.PAS < prev   
Pascal/Delphi Source File  |  1995-07-11  |  7KB  |  281 lines
  1. {============================================================================+
  2. ||    Bush - A clone of DOS tree.                                              ||
  3. ||    The bush-wacker-man prints those branches real fast                      ||
  4. ||                                                                             ||
  5. ||    (c)Lee Kindness                                                          ||
  6. ||                                                                           ||
  7. ||                                                                             ||
  8. +============================================================================}
  9.  
  10. PROGRAM Bush(Input,Output);
  11.  
  12. {$F-,I-,R-,S-,V-,M 10,1,2,15}
  13.  
  14. { Units used by the program }
  15. USES
  16.     AmigaDOS, DOS, Exec, Amiga;
  17.     
  18. {----------------------------------------------------------------------------}
  19. { Tranlates the given string into uppercase }
  20.  
  21. Function UpperStr(S : String) : String;
  22.  
  23. Var
  24.      X : Byte;
  25.      
  26. Begin
  27.   For X := 1 To Length(S) Do
  28.     S[X] := UpCase(S[X]);
  29.   UpperStr := S;
  30. End;
  31.  
  32. {----------------------------------------------------------------------------}
  33. { Uses Str to convert an integer to a string. More useful Function format }
  34.  
  35. Function IntToStr(VAR int : LongInt):String;
  36.  
  37. VAR    
  38.     tmp : String;
  39.     
  40. begin
  41.     Str(int,tmp);
  42.     IntToStr := tmp;
  43. end;
  44.  
  45. {----------------------------------------------------------------------------}
  46. { Get options from the command line, print help message if '?' }
  47.  
  48. Function ParseArgs(VAR l : BPTR; VAR size, flags, dir : Boolean):Boolean;
  49.  
  50. VAR
  51.     n          : Byte;
  52.     RDArg      : pRDArgs;
  53.     TmpInt     : ^LongInt;
  54.     Template,s : String;
  55.     V2         : Boolean;
  56.  
  57. CONST
  58.     RD_Array : Array[0..3] of LongInt = (0);
  59.     OurDir   : String[1] = ''#0;
  60.     
  61. begin
  62.     Template := 'DIRECTORY,SIZE/S,FLAGS/S,DIR/S'#0;
  63.                     
  64.     If pExecBase(SysBase)^.LibNode.lib_Version >= 36 then V2 := True else V2 := False;
  65.     
  66.     If V2 then begin
  67.         { WB 2 or greater :-) }
  68.         RDArg := NIL;
  69.         RDArg := ReadArgs(@Template[1],@RD_Array,RDArg);
  70.         
  71.         if NOT (RD_Array[0] = 0) then
  72.             l := lock(Pointer(RD_Array[0]), ACCESS_READ)
  73.         else
  74.             l := lock(@OurDir[1], ACCESS_READ);
  75.         
  76.         if RD_Array[1] <> 0 then Size := True else size := false;
  77.         if RD_Array[2] <> 0 then Flags := True else Flags := false;
  78.         if RD_Array[3] <> 0 then Dir := True else Dir := false;
  79.         
  80.         FreeArgs(RDArg);
  81.         ParseArgs := True;
  82.             
  83.     end else begin
  84.         { not WB 2 :-( Lets be compatible :-|}
  85.         if (ParamStr(1)='?') then begin
  86.             Writeln(template);
  87.             ParseArgs := False;
  88.         end else begin
  89.             if (UpperStr(ParamStr(1)) = 'SIZE') OR (UpperStr(ParamStr(1)) = 'FLAGS')
  90.                 OR (ParamCount = 0) OR (UpperStr(ParamStr(1)) = 'DIR') then
  91.                 l := lock(NIL, ACCESS_READ)
  92.             else begin
  93.                 s := ParamStr(1)+#0;
  94.                 l := lock(@s[1], ACCESS_READ);
  95.             End;
  96.             For n := 1 to ParamCount do begin
  97.                 If UpperStr(ParamStr(n)) = 'SIZE' then 
  98.                     Size := True;
  99.                 If UpperStr(ParamStr(n)) = 'FLAGS' then 
  100.                     flags := True;
  101.                 If UpperStr(ParamStr(n)) = 'DIR' then 
  102.                     Dir := True;
  103.             end;
  104.             ParseArgs := True;
  105.         end;
  106.     end;
  107. end;
  108.         
  109. Function MakeFlags(protection : LongInt):String;
  110. { create a string representing the protection of a file }
  111.  
  112. VAR 
  113.     tmpstr : String;
  114.     
  115. Begin
  116.     tmpStr := '';
  117.     if (Protection and FIBF_SCRIPT)<> 0 then
  118.         tmpstr := 's'
  119.     else 
  120.         tmpstr := '-';
  121.     if (Protection and FIBF_PURE) <> 0 then
  122.         tmpstr := tmpstr + 'p'
  123.     else 
  124.         tmpstr := tmpstr + '-';
  125.     if (Protection and FIBF_ARCHIVE) <> 0 then
  126.         tmpstr := tmpstr + 'a'
  127.     else 
  128.         tmpstr := tmpstr + '-';
  129.     if (Protection and FIBF_READ) = 0 then
  130.         tmpstr := tmpstr + 'r'
  131.     else 
  132.         tmpstr := tmpstr + '-';
  133.     if (Protection and FIBF_WRITE) = 0 then
  134.         tmpstr := tmpstr + 'w'
  135.     else 
  136.         tmpstr := tmpstr + '-'; 
  137.     if (Protection and FIBF_EXECUTE) = 0 then
  138.         tmpstr := tmpstr + 'e'
  139.     else 
  140.         tmpstr := tmpstr + '-';
  141.     if (Protection and FIBF_DELETE) = 0 then
  142.         tmpstr := tmpstr + 'd'
  143.     else 
  144.         tmpstr := tmpstr + '-';
  145.     MakeFlags := '('+TmpStr+')';
  146. end;
  147.         
  148. Function FormatName(DirLevel : Byte; Directory : Boolean; 
  149.                         Name, dirStr : String; I_Size, I_Protection : LongInt;
  150.                         B_Size, B_Flags : Boolean):String;
  151. { Create the string to be displayed }
  152.  
  153. VAR 
  154.     tmp : string;
  155.     z   : byte;
  156.  
  157. begin
  158.     If Directory then
  159.         tmp := ' |-'+Name + dirstr
  160.     else begin
  161.         tmp := ' | '+Name;
  162.         if B_Size then
  163.             tmp := tmp + ' (' + IntToStr(I_Size) + ' bytes)';
  164.         if B_Flags then
  165.             tmp := tmp + ' ' + MakeFlags(I_Protection);
  166.     end;
  167.             
  168.     for z := 2 to DirLevel do 
  169.         tmp := ' | ' + tmp;
  170.         
  171.     FormatName := tmp;
  172. end;
  173.  
  174. {----------------------------------------------------------------------------}
  175. { Print tree to std_out, This procedure calls itself in order to handle      }
  176. { sub-directories. }
  177.  
  178. Function CreateTree(VAR loc : BPTR; initial, Size, Flags, Dir : Boolean;
  179.                             DirStr : String):Boolean;
  180.  
  181.  
  182. VAR
  183.     olddir, l : BPTR;
  184.     OKRes, noBreak : Boolean;
  185.     fib       : pFileInfoBlock;
  186.     filenum, dirnum   : integer;
  187.     tmpn      : byte;
  188.     Signals   : LongInt;
  189.  
  190. CONST
  191.     n : Byte = 0; { holds the current number of recurses }
  192.     
  193. Begin 
  194.     NoBreak := True;
  195.     If Initial then n := 0;
  196.     filenum := 0;
  197.     dirnum := 0;
  198.     inc(n);
  199.     OldDir := CurrentDir(loc);
  200.     Fib := AllocMem(sizeof(tFileInfoBlock),MEMF_PUBLIC);
  201.     if fib <> NIL then begin
  202.         OKRes := Examine(loc,fib);
  203.         While OKRes and NoBreak do begin
  204.             inc(filenum);
  205.             if Filenum <> 1 then begin
  206.                 if (fib^.fib_DirEntryType > 0) then begin
  207.                     inc(dirnum);
  208.                     writeln(FormatName(n,true,PtrToPas(@fib^.fib_FileName),
  209.                             dirstr,0,0,false,false));
  210.                     tmpn := n;
  211.                     l := lock(@fib^.fib_FileName, ACCESS_READ);
  212.                     NoBreak := CreateTree(l, false,size,flags,dir,DirStr); { recurse }
  213.                     n := tmpn;
  214.                     unlock(l);
  215.                 end else
  216.                     if Not dir then
  217.                     writeln(FormatName(n,false,PtrToPas(@fib^.fib_FileName),
  218.                             dirstr,fib^.fib_Size,fib^.fib_Protection,Size,Flags));
  219.             end;
  220.             OKRes := ExNext(loc,fib);
  221.             signals := SetSignal(0,0);
  222.             { check for Ctrl-C break by user }
  223.             If (Signals and SIGBREAKF_CTRL_C) <> 0 then begin
  224.                 Writeln('***Break');
  225.                 NoBreak := False;
  226.                 Signals := SetSignal(0,SIGBREAKF_CTRL_C);
  227.             end;
  228.         end;
  229.         If NoBreak then begin
  230.             If (NOT Initial) and (NOT Dir) then
  231.                 writeln(FormatName(n-1,false,' °',dirstr,0,0,false,false))
  232.             else
  233.                 if (DIR and (dirnum > 0)) then
  234.                     writeln(FormatName(n-1,false,' °',dirstr,0,0,false,false));
  235.         end else
  236.             if NoBreak and (DirNum > 0) then
  237.                 writeln(' °');
  238.         FreeMem_(fib, Sizeof(tFileInfoBlock));
  239.     end;
  240.     Olddir := Currentdir(olddir);
  241.     CreateTree := NoBreak;
  242. end;
  243.  
  244. {----------------------------------------------------------------------------}
  245.  
  246. Procedure Main;
  247.  
  248. VAR
  249.     loc : BPTR;
  250.     OK  : Boolean;
  251.     
  252. CONST
  253.     V_Size  : Boolean = False;
  254.     V_Flags : Boolean = False;
  255.     V_Dir   : Boolean = False;
  256. { Version string for C:Version to Find }
  257.     Version : String[41] = '$VER: Bush v1.4 (27.09.94) ©Lee Kindness'#0;
  258.     DirStr : String[6] = ' <dir>';
  259.     rc : Byte = 0;
  260.     
  261. begin
  262.     OK := ParseArgs(loc, V_Size, V_Flags, V_Dir);
  263.     if OK then begin
  264.         If Loc <> 0 then begin
  265.             If V_Dir then DirStr := '';
  266.             Writeln(' ',FExpandLock(loc),''#10+
  267.                   ' |');
  268.             OK := CreateTree(loc, true, V_Size, V_Flags, V_Dir, DirStr);
  269.             UnLock(loc);
  270.         end;
  271.     end;
  272.     OK := PrintFault(IOErr,NIL);
  273. end;
  274.  
  275. {----------------------------------------------------------------------------}
  276.  
  277. begin
  278. main;
  279. end.
  280.  
  281. {----------------------------------------------------------------------------}